KHAI BAO APPACTIVATE

Private Sub Command1_Click()
    Dim MyAppID, ReturnValue
    AppActivate "Microsoft Word"
    MyAppID = Shell("C:\WORD\WINWORD.EXE", 1)
    AppActivate MyAppID
    ReturnValue = Shell("c:\EXCEL\EXCEL.EXE", 1)
    AppActivate ReturnValue
End Sub

KHAI BAO BEEP

Private Sub Command1_Click()
    Dim Str As String
    Str = "Welcome to huu khang . com"
    Beep
End Sub

KHAI BAO CALL

Private Sub Command1_Click()
    Dim str As String
    str = " huu khang . com"
    ABC()
    Call ABCD(str) 
    Dim i As Integer
    I=XYZ
End Sub

Sub ABC()
    MsgBox "Welcome to huukhang.com"
End Sub

Sub ABCD(ByVal strname As String)
    MsgBox " Welcome to " & strname
End Sub

Function XYZ() As Integer
    XYZ = 10
End Function

KHAI BAO CHDIR

Private Sub Command1_Click()
    ChDir "MYDIR"
    ChDir "D:\WINDOWS\SYSTEM"
End Sub

KHAI BAO CHDRIVE

Private Sub Command1_Click()
    ChDrive ""
    ChDrive "D:\"
End Sub

KHAI BAO CLOSE

Private Sub Command1_Click()
    Dim I, FileName
    For I = 1 To 3
       FileName = "TEST" & I
       Open FileName For Output As #I
       Print #I, "This is a test."
    Next I
    Close
End Sub


Function getDBInfo() As String
On Error GoTo err
Dim f As Integer
Dim strWord As String
f = FreeFile
Open App.Path & "\config.ini" For Input As f
Do While Not EOF(f)
     Line Input #f, strWord
Loop
Close f
getDBInfo = strWord
Exit Function
err:
    getDBInfo = Error
End Function

KHAI BAO CONST

Const MyVar = 459

Public Const MyString = "HELP"

Private Const MyInt As Integer = 5

Const MyStr = "Hello", MyDouble As Double = 3.4567

Private Const myBoolean As Boolean = True

Private Sub Command1_Click()
    Debug.Print MyVar
    Debug.Print MyInt
    Debug.Print MyStr
    Debug.Print MyDouble
    Debug.Print MyString
End Sub

KHAI BAO DECLARE

Declare Function GetUserName Lib _
"advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Private Sub Command1_Click()
Dim sbuf As String, nl As Integer
Dim Uname As String
sbuf = String$(10, 0)
nl = GetUserName(sbuf, 10)
Uname = UCase(sbuf)
If Uname <> "" Then
    MsgBox ("Username: " & Uname)
End If
End Sub

KHAI BAO DELETESETTING

Private Sub Command1_Click()
    SaveSetting appname:="huukhang.com", _
    section:="Startup", Key:="Top", setting:=75
    SaveSetting "huukhang.com", _
"Startup", "Left", 50
     DeleteSetting "huukhang.com", "Startup"
End Sub

KHAI BAO DIM

Private Sub Command1_Click()
    Dim AnyValue, MyValue
    
    Dim Number As Integer
    
    Dim AnotherVar, Choice As Boolean
    
    Dim DayArray(50)
    
    Dim Matrix(3, 4) As Integer
    
    Dim MyMatrix(1 To 5, 4 To 9, 3 To 5) As Double
    
    Dim BirthDay(1 To 10) As Date
    
    Dim MyArray()
End Sub

KHAI BAO DO..LOOP

Private Sub Command1_Click()
    Dim Check, Counter
    Check = True: Counter = 0
    Do   
       Do While Counter < 20
          Counter = Counter + 1
          Debug.Print Counter
          If Counter = 10 Then
             Check = False
             Exit Do
          End If
       Loop
    Loop Until Check = False
End Sub

KHAI BAO END

Private Sub Command1_Click()
   Dim Password, Pword
   Password = "123456"
   Pword = InputBox("Type in your password")
   If Pword <> Password Then
      MsgBox "Sorry, incorrect password"
      End
   End If
End Sub

KHAI BAO ERASE


Private Sub Command1_Click()
    Dim NumArray(10) As Integer
    Dim StrVarArray(10) As String
    Dim StrFixArray(10) As String * 10
    Dim VarArray(10) As Variant
    Dim DynamicArray() As Integer
    ReDim DynamicArray(10)
    Erase NumArray
    Erase StrVarArray
    Erase StrFixArray
    Erase VarArray
    Erase DynamicArray
End Sub

KHAI BAO ERROR
Private Sub Command1_Click()
    On Error Resume Next
    Error 11
    Debug.Print Err.Description
    Debug.Print Err.Source
    Debug.Print Err.Number
End Sub

KHAI BAO EXIT
Private Sub Command1_Click()
   Dim I, MyNum
   Do
      For I = 1 To 1000
         MyNum = Int(Rnd * 1000)
         Select Case MyNum
            Case 7: Exit For
            Case 29: Exit Do
            Case 54: Exit Sub
         End Select
      Next I
   Loop
End Sub

KHAI BAO FILECOPY

Private Sub Command1_Click()
    Dim SourceFile, DestinationFile
    SourceFile = "C:\CONFIG.SYS"
    DestinationFile = "D:\CONFIG.SYS"
    FileCopy SourceFile, DestinationFile
End Sub

KHAI BAO FOR EACH..NEXT

Private Sub Command1_Click()
    Dim Found, MyObject, MyCollection
    Found = False
    For Each MyObject In MyCollection
       If MyObject.Text = "Hello" Then
          Found = True
          Exit For
       End If
    Next
End Sub

KHAI BAO FOR..NEXT

Private Sub Command1_Click()
    Dim Words, Chars, MyString
    For Words = 10 To 1 Step -1
       For Chars = 0 To 9
          MyString = MyString & Chars
       Next Chars
       MyString = MyString & " "
       Debug.Print MyString
    Next Words
End Sub

KHAI BAO FUNCTION

Function CalculateSquareRoot( _
NumberArg As Double) As Double
   If NumberArg < 0 Then
      Exit Function
   Else
      CalculateSquareRoot = Sqr(NumberArg)
   End If
End Function

Function CalSum (ByVal FirstArg As Integer, _
ParamArray OtherArgs()) As Integer
   If FirstArg < 0 Then
      Exit Function
   Else
      CalSum = FirstArg+Total
   End If
End Function

Function MyFunc(MyArg As Integer, _
Optional MyArg1 As Integer = 5, _
Optional MyArg2 = 10) As Integer
    MyFunc MyArg + MyArg1 + MyArg2
End Function

Private Sub Command1_Click()
    Debug.Print CalculateSquareRoot(10)
    Debug.Print CalSum(10, 1, 2, 3, 4, 5)
    Dim RetVal
    RetVal = MyFunc(1, 2, 2)
    Debug.Print RetVal
    RetVal = MyFunc(1, , 5)
    Debug.Print RetVal
    RetVal = MyFunc(MyArg:=10, MyArg2:=7)
    Debug.Print RetVal
    RetVal = MyFunc(1)
    Debug.Print RetVal
End Sub

KHAI BAO GOTO

Private Sub Command1_Click()
    Dim Number, MyString
    Number = 1
    If Number = 1 Then
        GoTo Line1
    Else
        GoTo Line2
    End If
Line1:
    MyString = "Number equals 1"
    GoTo LastLine
Line2:
MyString = "Number equals 2"
LastLine:
    Debug.Print MyString
End Sub

PHAUT BIEU IEAU KHIEN IF..THEN..ELSE..END IF

Private Sub Command1_Click()
    Dim A, B, C
    A = InputBox("Please enter value of A:")
    If IsNumeric(A) Then A = A + 1: B = B + A: C = C + B
    Debug.Print A
    B = InputBox("Please enter value of B:")
    If B > 0 Then
        A = A + B
    ElseIf B = 0 Then
        A = A - B
    Else
        A = B
    End If
End Sub

KHAI BAO INPUT #

Private Sub Command1_Click()
    Dim MyString, MyNumber
    Open "C:\TESTFILE.txt" For Input As #1
    Do While Not EOF(1)
       Input #1, MyString, MyNumber
       Debug.Print MyString, MyNumber
    Loop
    Close #1
End Sub

KHAI BAO KILL

Private Sub Command1_Click()
    Kill "C:\TestFile.txt" 
    Kill "C:\*.TXT"
End Sub

KHAI BAO LINE INPUT #

Private Sub Command1_Click()
    Dim MyString
    Open "C:\TESTFILE.txt" For Input As #1
    Do While Not EOF(1)
       Line Input #1, MyString
       Debug.Print MyString
    Loop
    Close #1
End Sub

KHAI BAO LOAD

Private Sub Command1_Click()
    Dim Answer, Msg As String
    Unload Form1
    Msg = "Form1 cha nap. "
    Msg = Msg & "Chon Yes e nap vao hien th form "
    Msg = Msg & "CHon No nap form vao khong hien th."
    Answer = MsgBox(Msg, vbYesNo)
    If Answer = vbYes Then
       Show
    Else
       Load Form1
       Msg = "Form1 ao nap. "
       Msg = Msg & "Chon OK e hien th form."
       MsgBox Msg
       Show
    End If
End Sub

KHAI BAO LOCK, UNLOCK

Private Sub Command1_Click()
    Dim MyRecord As Record, RecordNumber
    Open "C:\TESTFILE.txt" For _
    Random Shared As #1 Len = Len(MyRecord)
    RecordNumber = 4
    Lock #1, RecordNumber
    Get #1, RecordNumber, MyRecord
    MyRecord.ID = 234
    MyRecord.Name = "John Smith"
    Put #1, RecordNumber, MyRecord
    Unlock #1, RecordNumber
    Close #1
End Sub

KHAI BAO MID

Private Sub Command1_Click()
    Dim MyString
    MyString = "The dog jumps"
    Debug.Print MyString
    Mid(MyString, 5, 3) = "fox"
    Debug.Print MyString
    Mid(MyString, 5) = "cow"
    Debug.Print MyString
    Mid(MyString, 5) = "cow jumped over"
    Debug.Print MyString
    Mid(MyString, 5, 3) = "duck"
    Debug.Print MyString
End Sub

KHAI BAO MKDIR

Private Sub Command1_Click()
    Dim MyFolder
    MyFolder = "C:\myVb6"
    MkDir MyFolder
End Sub

KHAI BAO NAME


Private Sub Command1_Click()
    Dim OldName, NewName
    OldName = "OLDFILE": NewName = "NEWFILE"
    Name OldName As NewName
    OldName = "C:\MYDIR\OLDFILE"
    NewName = "C:\YOURDIR\NEWFILE"
    Name OldName As NewName
End Sub

KHAI BAO ON ERROR

Private Sub Command1_Click()
    On Error GoTo ErrorHandler
       Open "TESTFILE" For Output As #1
       Kill "TESTFILE"
       On Error GoTo 0
       On Error Resume Next
ObjectRef = GetObject("MyWord.Basic")
       If err.Number = 440 Or err.Number = 432 Then
          Msg = "There was an error attempting to open "
          Msg = Msg & "the Automation object!"
          MsgBox Msg, , "Deferred Error Test"
          err.Clear   
       End If
    Exit Sub
ErrorHandler:
    Select Case err.Number
Case 55
          Close #1
       Case Else
    End Select
    Resume
End Sub

KHAI BAO OPEN

Private Sub Command1_Click()
    Dim MyString
    Open "C:\TESTFILE.txt" For Input As #1
    Do While Not EOF(1)
       Line Input #1, MyString
       Debug.Print MyString
    Loop
    Close #1
End Sub

KHAI BAO OPTION BASE

Option Base 1

Private Sub Command1_Click()
    Dim Lower
    Dim MyArray(20), TwoDArray(3, 4)
    Dim ZeroArray(0 To 5)
    Lower = LBound(MyArray)
    Debug.Print Lower
    Lower = LBound(TwoDArray, 1)
    Debug.Print Lower
    Lower = LBound(TwoDArray, 2)
    Debug.Print Lower
    Lower = LBound(ZeroArray)
    Debug.Print Lower
End Sub

KHAI BAO PRINT #


Private Sub Command1_Click()
    Open "TESTFILE" For Output As #1
    Print #1, "This is a test"
    Print #1,
    Print #1, "Zone 1"; Tab; "Zone 2"
    Print #1, "Hello"; " "; "World"
    Print #1, Spc(5); "5 leading spaces "
    Print #1, Tab(10); "Hello"
    
    Dim MyBool, MyDate, MyNull, MyError
    MyBool = False: MyDate = #2/12/1969#
    MyNull = Null: MyError = CVErr(32767)

    Print #1, MyBool; " is a Boolean value"
    Print #1, MyDate; " is a date"
    Print #1, MyNull; " is a null value"
    Print #1, MyError; " is an error value"
    Close #1   
End Sub

KHAI BAO PUBLIC

Public piAs Integer
Private Sub Command1_Click()
    Dim AnyValue, MyValue
    
    Dim Number As Integer
    Number=5
    piAs=100+ Number
End Sub

Private Sub Command1_Click()
    Dim AnyValue, MyValue
    
    Dim Number As Integer
    Number=15
    piAs= piAs + Number
End Sub

KHAI BAO PUT

Type Record   
   ID As Integer
   Name As String * 20
End Type

Private Sub Command1_Click()
    Dim MyRecord As Record, RecordNumber
    Open "TESTFILE" For Random As #1 _
    Len = Len(MyRecord)
    For RecordNumber = 1 To 5
       MyRecord.ID = RecordNumber
       MyRecord.Name = "My Name" & RecordNumber
       Put #1, RecordNumber, MyRecord
    Next RecordNumber
    Close #1
End Sub

KHAI BAO RAISEEVENT

Private WithEvents mText As TimerState
Private Sub Command1_Click()
    Text1.Text = "From Now"
    Text1.Refresh
    Text2.Text = "0"
    Text2.Refresh
    Call mText.TimerTask(9.84)
End Sub

Private Sub Form_Load()
    Command1.Caption = "Click to Start Timer"
    Text1.Text = ""
    Text2.Text = ""
    Label1.Caption = _
   "The fastest 100 meters ever run took this long:"
    Set mText = New TimerState
    End Sub

Private Sub mText_ChangeText()
    Text1.Text = "Until Now"
    Text2.Text = "9.84"
End Sub

Private Sub mText_UpdateTime(ByVal dblJump As Double)
    Text2.Text = Str(Format(dblJump, "0"))
    DoEvents
End Sub

Option Explicit
Public Event UpdateTime(ByVal dblJump As Double)
Public Event ChangeText()

Public Sub TimerTask(ByVal Duration As Double)
    Dim dblStart As Double
    Dim dblSecond As Double
    Dim dblSoFar As Double
    dblStart = Timer
    dblSoFar = dblStart
    
    Do While Timer < dblStart + Duration
        If Timer - dblSoFar >= 1 Then
            dblSoFar = dblSoFar + 1
            RaiseEvent UpdateTime(Timer - dblStart)
        End If
    Loop
    RaiseEvent ChangeText    
End Sub

KHAI BAO RANDOMIZE

Private Sub Command1_Click()
   Dim MyValue
    Randomize
    MyValue = Int((6 * Rnd) + 1)
    Debug.Print MyValue
End Sub

KHAI BAO REDIM

Private Sub Command1_Click()
   Dim MyArray() As Integer
    ReDim MyArray(5)
    For I = 1 To 5
       MyArray(I) = I
    Next I
    
    
    ReDim MyArray(10)
   For I = 1 To 10
       MyArray(I) = I
    Next I
    
    
    ReDim Preserve MyArray(15)
End Sub

KHAI BAO REM

Private Sub Command1_Click()
    Dim MyStr1, MyStr2
    MyStr1 = "Hello"
    Rem Comment after a statement separated by a colon.
    MyStr2 = "Goodbye"
End Sub

KHAI BAO RESET

Private Sub Command1_Click()
    Dim FileNumber
    For FileNumber = 1 To 5   
       Open "TEST" & _
FileNumber For Output As #FileNumber
       Write #FileNumber, "Hello World"   
    Next FileNumber
    Reset
End Sub


KHAI BAO RMDIR

Private Sub Command1_Click()
    RmDir "C:\myFolder"
End Sub

KHAI BAO SAVEPICTURE

Private Sub Command1_Click()
   Dim CX, CY, Limit
   Dim Radius   As Integer, Msg As String
   ScaleMode = vbPixels
   AutoRedraw = True
   Width = Height
   CX = ScaleWidth / 2
   CY = ScaleHeight / 2
   Limit = CX
   For Radius = 0 To Limit
      Circle (CX, CY), Radius, RGB(Rnd * 255, _
      Rnd * 255, Rnd * 255)
      DoEvents
 Next Radius
   Msg = "Choose OK to save the graphics "
   Msg = Msg & "from this form to a bitmap file."
   MsgBox Msg
   SavePicture Me.Image, "C:\TEST1.jpg"
End Sub

KHAI BAO SAVESETTING

Private Sub Command1_Click()
    SaveSetting appname:="huukhang.com", _
    section:="Startup", Key:="Top", setting:=75
    SaveSetting "huukhang.com", _
"Startup", "Left", 50
     DeleteSetting "huukhang.com", "Startup"
End Sub

KHAI BAO SEEK


Private Sub Command1_Click()
    Dim MyRecord As Record, MaxSize, RecordNumber
    Open "TESTFILE" For Random As #1 Len = Len(MyRecord)
    MaxSize = LOF(1) \ Len(MyRecord)
    For RecordNumber = MaxSize To 1 Step -1
       Seek #1, RecordNumber
       Get #1, , MyRecord
    Next RecordNumber
    Close #1
End Sub

KHAI BAO SELECT CASE

Private Sub Command1_Click()
    Dim Number
    Number = InputBox("Please enter number")
    Select Case Number
        Case 1 To 5
           Debug.Print "Between 1 and 5"
        Case 6, 7, 8
Debug.Print "Between 6 and 8"
        Case 9 To 10
            Debug.Print "Greater than 8 & less than 10"
        Case Is > 10
            Debug.Print "More than 10"
        Case Else
           Debug.Print "Not more than 1"
    End Select
End Sub

KHAI BAO SENDKEYS

Private Sub Command1_Click()
    Dim ReturnValue, I
    ReturnValue = Shell("CALC.EXE", 1)
    AppActivate ReturnValue
    For I = 1 To 100
       SendKeys I & "{+}", True
    Next I
    SendKeys "=", True
    SendKeys "%{F4}", True
End Sub

KHAI BAO SET

Private Sub Command1_Click()
    Dim myCon, myRst
    Set myCon = CreateObject("ADODB.Connection")
    Set myRst = CreateObject("ADODB.Recordset")
    myCon.Open strCon
    Set myRst = Nothing
    Set myCon = Nothing
End Sub

KHAI BAO SETATTR

Private Sub Command1_Click()
    SetAttr "c:TESTFILE.txt", vbHidden
    SetAttr "TESTFILE", vbHidden + vbReadOnly
End Sub

KHAI BAO STATIC

Function KeepTotal(Number)
   Static Accumulate
   Accumulate = Accumulate + Number
   KeepTotal = Accumulate
End Function

Static Function MyFunction(Arg1, Arg2, Arg3)
   Accumulate = Arg1 + Arg2 + Arg3
   Half = Accumulate / 2
   MyFunction = Half
End Function

Private Sub Command1_Click()
    Dim ldTotal As Double
    ldTotal = KeepTotal(10)
    ldTotal = ldTotal + MyFunction(1, 2, 3)
    Debug.Print ldTotal
End Sub

KHAI BAO STOP

Private Sub Command1_Click()
    Dim ldTotal As Double
    ldTotal = 10
    Debug.Print ldTotal
    Stop
    ldTotal = ldTotal + 20
    Debug.Print ldTotal
End Sub

KHAI BAO SUB


Public Accumulate As Integer
Sub KeepTotal(Number)
    Accumulate = Accumulate + Number
    Number = Number + 10
End Sub


Private Sub Command1_Click()
    Dim ldTotal As Double
    Accumulate = 0
    ldTotal = 10
    KeepTotal (ldTotal)
    ldTotal = Accumulate
    Debug.Print Accumulate
    ldTotal = Number
    Debug.Print ldTotal
End Sub

KHAI BAO TYPE

Type EmployeeRecord   
   ID As Integer
   Name As String
   Address As String
   Phone As Long
   HireDate As Date
End Type
Private Sub Command1_Click()
    Dim Employees(10) As EmployeeRecord
    Dim i As Integer
    For i = 0 To 9
        Employees(i).ID = i
        Employees(i).Name = "Pham Huu Khang " & i
    Next
    For i = 0 To 9
        Debug.Print Employees(i).ID & " " & _
Employees(i).Name
    Next
End Sub

KHAI BAO UNLOAD

Private Sub Command1_Click()
    Unload frmEmployee
    Unload Me
End Sub

KHAI BAO WHILE..WEND

Private Sub Command1_Click()
    Dim Counter
    Counter = 0
    While Counter < 20
        Counter = Counter + 1
    Wend
    Debug.Print Counter
End Sub

KHAI BAO WIDTH
Private Sub Command1_Click()
    Dim I
    Open "TESTFILE" For Output As #1
     M tap tin e ghi
    VBA.Width 1, 5
    For I = 0 To 9
       Print #1, Chr(48 + I);
    Next I
    Close #1
End Sub

KHAI BAO WITH..END WITH

Private Sub Command1_Click()
    Dim MyObject As Object
    Set MyObject = Me
    With MyObject
        .Width = 100
.Caption = "Hello World"
    End With
End Sub

KHAI BAO WRITE

Private Sub Command1_Click()
    Open "C:\teo.txt" For Output As #1
    Write #1, "Hello World", 234
    Write #1,
    Dim MyBool, MyDate, MyNull, MyError
    MyBool = False: MyDate = #2/12/1969#
    MyNull = Null
    MyError = CVErr(32767)
    Write #1, MyBool; " is a Boolean value"
    Write #1, MyDate; " is a date"
    Write #1, MyNull; " is a null value"
    Write #1, MyError; " is an error value"
    Close #1   
End Sub










